;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2022 ( <paren@disroot.org>
;;;
;;; This file is not part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guixrus home services emacs)
  #:use-module (gnu home services)
  #:use-module (gnu home services shepherd)
  #:autoload   (gnu packages emacs) (emacs-minimal
                                     emacs)
  #:use-module (gnu services configuration)
  #:use-module (guix gexp)
  #:use-module (guix packages)
  #:use-module (guix records)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)

  #:export (home-emacs-configuration
            home-emacs-service-type))

(define list-of-file-likes?
  (list-of file-like?))

(define-configuration/no-serialization home-emacs-configuration
  (emacs
   (file-like emacs)
   "The package providing @file{/bin/emacs}.")
  (packages
   (list-of-file-likes '())
   "Packages to add to the Emacs plugin load path.")
  (native-compile?
   (boolean #f)
   "Whether to compile the @code{packages} using the Emacs package
provided as the value of the @code{emacs} field, which will enable
native compilation if the @code{emacs} package supports it.")
  (init-file
   (file-like (plain-file "init.el" ""))
   "File-like to use as the initialisation Lisp file.")
  (early-init-file
   (file-like (plain-file "early-init.el" ""))
   "File-like to use as the pre-initialisation Lisp file.")
  (debug?
   (boolean #f)
   "Whether to enable debugging."))

(define (home-emacs-profile-packages config)
  (list (home-emacs-configuration-emacs config)))

(define (home-emacs-transformed-packages config)
  (map (if (home-emacs-configuration-native-compile? config)
           (package-input-rewriting
            `((,emacs-minimal
              . ,(home-emacs-configuration-emacs config))))
           identity)
       (let ((packages (home-emacs-configuration-packages config)))
         (concatenate
          (cons packages
                (map (compose (cute map second <>)
                              package-transitive-propagated-inputs)
                     packages))))))

(define (home-emacs-shepherd-services config)
  (list (shepherd-service
         (provision '(emacs))
         (documentation "Start the Emacs daemon.")
         (modules '((ice-9 ftw)
                    (srfi srfi-1)
                    (srfi srfi-26)))
         (start
          #~(make-forkexec-constructor
             (list #$(file-append
                      (home-emacs-configuration-emacs config)
                      "/bin/emacs")
                   "--fg-daemon" "--eval"
                   (format #f "~s"
                           `(progn
                             (setq custom-file
                                   (concat (or (getenv "XDG_CONFIG_HOME")
                                               (concat (getenv "HOME")
                                                       "/.config"))
                                           "/emacs/custom.el"))
                             (load custom-file)))
                   #$@(if (home-emacs-configuration-debug? config)
                          (list "--debug-init")
                          '()))
             #:log-file
             (format #f "~a/emacs.log"
                     (or (getenv "XDG_LOG_HOME")
                         (format #f "~a/.local/var/log"
                                 (getenv "HOME"))))
             #:environment-variables
             (let ((env-var
                    (lambda (name path)
                      (define (regular-directory? directory)
                        (not (member directory (list "." ".."))))

                      (define (package-paths package)
                        (let ((directory (string-append package "/" path)))
                          (if (file-exists? directory)
                              (cons directory
                                    (map (cute string-append directory "/" <>)
                                         (scandir directory regular-directory?)))
                              '())))

                      (let ((old-value (getenv name)))
                        (string-append
                         name "="
                         (string-join
                          (append-map
                           package-paths
                           (list #$@(home-emacs-transformed-packages config)))
                          ":" (if old-value
                                  'suffix
                                  'infix))
                         (or old-value ""))))))
               (append (default-environment-variables)
                       (list (env-var "EMACSLOADPATH"
                                      "share/emacs/site-lisp")
                             (env-var "EMACSNATIVELOADPATH"
                                      "lib/emacs/native-site-lisp"))))))
         (stop
          #~(make-forkexec-constructor
             (list #$(file-append
                      (home-emacs-configuration-emacs config)
                      "/bin/emacsclient")
                   "--eval" "(kill-emacs)"))))))

(define (home-emacs-xdg-configuration-files config)
  `(("emacs/early-init.el"
     ,(home-emacs-configuration-early-init-file config))
    ("emacs/init.el"
     ,(home-emacs-configuration-init-file config))))

(define home-emacs-service-type
  (service-type
   (name 'home-emacs)
   (extensions
    (list (service-extension
           home-profile-service-type
           home-emacs-profile-packages)
          (service-extension
           home-shepherd-service-type
           home-emacs-shepherd-services)
          (service-extension
           home-xdg-configuration-files-service-type
           home-emacs-xdg-configuration-files)))
   (default-value (home-emacs-configuration))
   (description
    "Configure and run the GNU Emacs extensible text editor.")))
